home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / mouse.swg / 0025_Graphics Mouse Cursor.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  31.8 KB  |  869 lines
  1.  
  2. UNIT  uMCursor;                               { (c) 1994 by NEBULA-Soft. }
  3.       { Mausroutinen für Textmodus          } { Olaf Bartelt & Oliver Carow }
  4. { ═════════════════════════════ } INTERFACE { ═════════════════════════════ }
  5. USES  DOS, video;                             { Einbinden der Units         }
  6.  
  7. { The unit VIDEO is also included in the SWAG distribution in the CRT.SWG   }
  8.  
  9. { ─ Konstantendeklarationen ─────────────────────────────────────────────── }
  10. CONST cLinke_taste                 = 1;       { linke Maustaste             }
  11.       cRechte_taste                = 2;       { rechte Maustaste            }
  12.       cMittlere_taste              = 4;       { mittlere Maustaste (bei 3)  }
  13.  
  14.       cursor_location_changed      = 1;
  15.       left_button_pressed          = 2;
  16.       left_button_released         = 4;
  17.       right_button_pressed         = 8;
  18.       right_button_released        = 16;
  19.       middle_button_pressed        = 32;
  20.       middle_button_released       = 64;
  21.  
  22.       lastmask                     : WORD    = 0;
  23.       lasthandler                  : POINTER = NIL;
  24.  
  25.       click_repeat                 = 10;
  26.       mousetextscale               = 8;
  27.       vgatextgraphiccursor         : BOOLEAN = FALSE;
  28.  
  29.  
  30. { ─ Typendeklarationen ──────────────────────────────────────────────────── }
  31. TYPE  mousetype                    = (twobutton, threebutton, another);
  32.       buttonstate                  = (buttondown, buttonup);
  33.       direction                    = (moveright, moveleft, moveup, movedown,
  34. nomove);
  35.  
  36. { ─ Variablendeklarationen ──────────────────────────────────────────────── }
  37. VAR   mouse_present                : BOOLEAN;
  38.       mouse_buttons                : mousetype;
  39.       eventx, eventy, eventbuttons : WORD;
  40.       eventhappened                : BOOLEAN;
  41.       xmotions, ymotions           : WORD;
  42.       mousecursorlevel             : INTEGER;
  43.       fontpoints                   : BYTE;
  44.  
  45.       maxmousex             : INTEGER;
  46.       maxmousey                    : INTEGER;
  47.  
  48.  
  49. { ─ exportierte Prozeduren und Funktionen ───────────────────────────────── }
  50. PROCEDURE set_graphic_mouse_cursor;        { graphischen Mousecursor setzen }
  51. PROCEDURE showmousecursor;
  52.  
  53. { ══════════════════════════ } IMPLEMENTATION { ═══════════════════════════ }
  54. {$IFDEF VER60}                                { in TP 6.0 gibt es SEGxxxx   }
  55. CONST SEG0040 = $0040;                        { noch nicht! => definieren!  }
  56.       SEGB800 = $B800;
  57.       SEGA000 = $A000;
  58. {$ENDIF}
  59.  
  60. { ─ Typendeklarationen ──────────────────────────────────────────────────── }
  61. TYPE  pTextgraphikcursor = ^tTextgraphikcursor;  { Zeiger auf Array         }
  62.       tTextgraphikcursor = ARRAY[0..31] OF LONGINT;
  63.  
  64.       box                = RECORD
  65.                              left, top, right, bottom : WORD;
  66.                            END;
  67.       pChardefs          = ^tChardefs;
  68.       tChardefs          = ARRAY[0..(32*8)] OF BYTE;
  69.  
  70. { ─ Konstantendeklarationen ─────────────────────────────────────────────── }
  71. CONST pfeil                  : tTextgraphikcursor =
  72. { Maske:  } ($3FFFFFFF, $1FFFFFFF, $0FFFFFFF, $07FFFFFF, $03FFFFFF, $01FFFFFF,
  73.              $00FFFFFF, $007FFFFF, $003FFFFF, $007FFFFF, $01FFFFFF, $10FFFFFF,
  74.              $B0FFFFFF, $F87FFFFF, $F87FFFFF, $FcFFFFFF,
  75. { Cursor: }  $00000000, $40000000, $60000000, $70000000, $78000000, $7C000000,
  76.              $7E000000, $7F000000, $7F800000, $7F000000, $7C000000, $46000000,
  77.              $06000000, $03000000, $03000000, $00000000);
  78.  
  79.       sanduhr : tTextgraphikcursor =        ($0001FFFF,  { 0000000000000001 }
  80.                 { Cursorform:      }         $0001FFFF,  { 0000000000000001 }
  81.                                              $8003FFFF,  { 1000000000000011 }
  82.                                              $C7C7FFFF,  { 1100011111000111 }
  83.                                              $E38FFFFF,  { 1110001110001111 }
  84.                                              $F11FFFFF,  { 1111000100011111 }
  85.                                              $F83FFFFF,  { 1111100000111111 }
  86.                                              $FC7FFFFF,  { 1111110001111111 }
  87.                                              $F83FFFFF,  { 1111100000111111 }
  88.                                              $F11FFFFF,  { 1111000100011111 }
  89.                                              $E38FFFFF,  { 1110001110001111 }
  90.                                              $C7C7FFFF,  { 1100011111000111 }
  91.                                              $8003FFFF,  { 1000000000000011 }
  92.                                              $0001FFFF,  { 0000000000000001 }
  93.                                              $0001FFFF,  { 0000000000000001 }
  94.                                              $0000FFFF,  { 0000000000000000 }
  95.                                                 { ^^^^ immer! (Textmodus)   }
  96.                 { Bildschirmmaske: }         $00000000,  { 0000000000000000 }
  97.                                              $7FFC0000,  { 0111111111111100 }
  98.                                              $20080000,  { 0010000000001000 }
  99.                                              $10100000,  { 0001000000010000 }
  100.                                              $08200000,  { 0000100000100000 }
  101.                                              $04400000,  { 0000010001000000 }
  102.                                              $02800000,  { 0000001010000000 }
  103.                                              $01000000,  { 0000000100000000 }
  104.                                              $02800000,  { 0000001010000000 }
  105.                                              $04400000,  { 0000010001000000 }
  106.                                              $08200000,  { 0000100000100000 }
  107.                                              $10100000,  { 0001000000010000 }
  108.                                              $20080000,  { 0010000000001000 }
  109.                                              $7FFC0000,  { 0111111111111100 }
  110.                                              $00000000,  { 0000000000000000 }
  111.                                              $00000000); { 0000000000000000 }
  112.                                                 { ^^^^ immer! (Textmodus)   }
  113.  
  114.       vgatextgraphicptr      : pTextgraphikcursor = @pfeil;
  115.                                                   { @sanduhr                }
  116. { ─ Variablendeklarationen ──────────────────────────────────────────────── }
  117. VAR   hidebox                : box;
  118.       regs                   : REGISTERS;
  119.       vgastoredarray         : ARRAY[1..3, 1..3] OF BYTE;
  120.       lasteventx, lasteventy : WORD;
  121.       hasstoredarray         : BOOLEAN;
  122.       oldexitproc            : POINTER;
  123.  
  124. CONST chardefs               : pChardefs = NIL;
  125.       charheight             = 16;
  126.       defchar                = $D0;
  127.  
  128.  
  129. { ─ exportierte Prozeduren und Funktionen ───────────────────────────────── }
  130. procedure swap(var a,b : word);
  131. var c : word;
  132. begin
  133.  c := a;
  134.  a := b;
  135.  b := c; {swap a and b}
  136. end; {swap}
  137.  
  138. procedure setMouseCursor(x,y : word);
  139. begin
  140.  with regs do begin
  141.   ax := 4;
  142.   cx := x;
  143.   dx := y; {prepare parameters}
  144.   INTR($33, regs);
  145.  end; {with}
  146. end; {setMouseCursor}
  147.  
  148. FUNCTION x : WORD;
  149. BEGIN
  150.   regs.AX := 3;
  151.   INTR($33, regs);
  152.   x := regs.CX;
  153. END;
  154.  
  155. FUNCTION y : WORD;
  156. BEGIN
  157.   regs.AX := 3;
  158.   INTR($33, regs);
  159.   y := regs.DX;
  160. END;
  161.  
  162. procedure mouseBox(left,top,right,bottom : word);
  163. begin
  164.  if (left > right) then swap(left,right);
  165.  if (top > bottom) then swap(top,bottom); {make sure they are ordered}
  166.  regs.ax := 7;
  167.  regs.cx := left;
  168.  regs.dx := right;
  169.  INTR($33, regs); {set x range}
  170.  regs.ax := 8;
  171.  regs.cx := top;
  172.  regs.dx := bottom;
  173.  INTR($33, regs); {set y range}
  174. end; {mouseBox}
  175.  
  176.  
  177. PROCEDURE initmouse;
  178. VAR overridedriver : BOOLEAN;                 { wegen Hercules-Karten       }
  179.     tempvideomode  : BYTE;                    { Zwischenspeicher für Modus  }
  180. BEGIN
  181.   overridedriver := FALSE;                    { erstmal nicht override!     }
  182.  
  183.   IF (FALSE AND (MEM[SEG0040:$0049] = 7)) THEN  { doch overriden?           }
  184.   BEGIN
  185.     MEM[SEG0040:$0049] := 6;                  { Ja: Videomodus vortäuschen  }
  186.     overridedriver := TRUE;                   {     und override setzen!    }
  187.   END;
  188.  
  189.   IF vgatextgraphiccursor = TRUE THEN         { Graphikcursor im Textmodus? }
  190.   BEGIN
  191.     tempvideomode := MEM[SEG0040:$0049];      { Videomodus zwischenspeichern}
  192.     MEM[SEG0040:$0049] := 6;                  { anderen Modus vortäuschen   }
  193.   END;
  194.  
  195.   WITH regs DO                                { Maustyp ermitteln           }
  196.   BEGIN                                       { und Anzahl der Tasten auch  }
  197.     AX := 0; BX := 0;                         { Maus initialisieren (00h)   }
  198.     INTR($33, regs);                          { Mausinterrupt aufrufen      }
  199.  
  200.     mouse_present := (AX <> 0);               { überhaupt Maus vorhanden?   }
  201.     IF (BX AND 2) <> 0 THEN mouse_buttons := twobutton  { Maustasten ermitt.}
  202.                        ELSE IF (BX AND 3) > 0 THEN mouse_buttons := threebutton
  203.                                               ELSE mouse_buttons := another;
  204.   END;
  205.  
  206.   IF overridedriver = TRUE THEN MEM[SEG0040:$0049] := 7;  { override?       }
  207.   IF vgatextgraphiccursor = TRUE THEN         { Graphikcursor im Textmodus? }
  208.     MEM[SEG0040:$0049] := tempvideomode;      { Ja: Modus restaurieren!     }
  209.  
  210.   IF (NOT vgatextgraphiccursor) THEN fontpoints := mousetextscale
  211.                                 ELSE fontpoints := MEM[SEG0040:$0085];
  212.   maxmousex := maxx * mousetextscale;         { Mausgrenzen ausrechnen      }
  213.   maxmousey := maxy * fontpoints;
  214.  
  215.   mousebox(0, 0, (visiblex * mousetextscale)-1, (visibley * fontpoints)-1);
  216.   eventbuttons := 0; eventhappened := FALSE;  { noch kein Event gewesen!    }
  217.  
  218.   xmotions := 8; ymotions := 16; mousecursorlevel := 0;  { Cursor nicht s.  }
  219.   hasstoredarray := FALSE;                    { noch keine Daten im Array   }
  220.  
  221.   setmousecursor(visiblex * mousetextscale DIV 2, visibley * fontpoints DIV 2);
  222.   eventx := x; eventy := y; lasteventx := eventx; lasteventy := eventy;
  223. END;
  224.  
  225. PROCEDURE vgascreen2array(newposition, s2a, defaultrange : BOOLEAN);
  226. VAR x, y : WORD;
  227.     w, h : WORD;
  228.     o, l : WORD;
  229.     i, j : BYTE;
  230. BEGIN
  231.   IF (newposition = TRUE) THEN
  232.   BEGIN
  233.     x := eventx DIV mousetextscale;
  234.     y := eventy DIV fontpoints;
  235.   END
  236.   ELSE
  237.   BEGIN
  238.     x := lasteventx DIV mousetextscale;
  239.     y := lasteventy DIV fontpoints;
  240.   END;
  241.  
  242.   w := visiblex - x; IF (w > 3) THEN w := 3;
  243.   h := visibley - y; IF (h > 3) THEN h := 3;
  244.   o := 2 * x + 2 * visiblex * y;
  245.   l := 2 * visiblex - 2 * w;
  246.  
  247.   IF (defaultrange = TRUE) THEN
  248.   BEGIN
  249.     FOR i := 0 TO h - 1 DO
  250.     BEGIN
  251.       FOR j := 0 TO w - 1 DO
  252.       BEGIN
  253.         MEM[SEGB800:o] := defchar + i * 3 + j;
  254.         INC(o, 2);
  255.       END;
  256.       INC(o, l);
  257.     END;
  258.   END
  259.   ELSE
  260.     IF (s2a = TRUE) THEN
  261.     BEGIN
  262.       FOR i := 1 TO h DO
  263.       BEGIN
  264.         FOR j := 1 TO w DO
  265.         BEGIN
  266.           vgastoredarray[i, j] := MEM[SEGB800:o];
  267.           INC(o, 2)
  268.         END;
  269.         INC(o, l);
  270.       END;
  271.     END
  272.     ELSE
  273.     BEGIN
  274.       FOR i := 1 TO h DO
  275.       BEGIN
  276.         FOR j := 1 TO w DO
  277.         BEGIN
  278.           MEM[SEGB800:o] := vgastoredarray[i, j];
  279.           INC(o, 2);
  280.         END;
  281.         INC(o, l);
  282.       END;
  283.     END;
  284. END;
  285.  
  286. PROCEDURE drawvgatextgraphiccursor;
  287. TYPE  lp = ^LONGINT;
  288. CONST sequencerport     = $3C4;
  289.       sequenceraddrmode = $704;
  290.       sequenceraddrnrml = $302;
  291.       vgacontrolerport  = $3CE;
  292.       cpureadmap2       = $204;
  293.       cpuwritemap2      = $402;
  294.       mapstartaddrA000  = $406;
  295.       mapstartaddrB800  = $E06;
  296.       oddevenaddr       = $304;
  297. VAR   o, s              : WORD;
  298.       i, j              : INTEGER;
  299.       s1, s2, s3        : WORD;
  300.       a                 : LONGINT;
  301.       d, mc, ms         : lp;
  302.  
  303. BEGIN
  304.   ASM
  305.     PUSHF
  306.     CLI
  307.     MOV DX, sequencerport
  308.     MOV AX, sequenceraddrmode
  309.     OUT DX, AX
  310.     MOV DX, vgacontrolerport
  311.     MOV AX, cpureadmap2
  312.     OUT DX, AX
  313.     MOV AX, 5
  314.     OUT DX, AX
  315.     MOV AX, mapstartaddrA000
  316.     OUT DX, AX
  317.     POPF
  318.   END;
  319.  
  320.    o := 0;
  321.    FOR i := 1 TO 3 DO
  322.    BEGIN
  323.      s1 := vgastoredarray[i, 1] * 32;
  324.      s2 := vgastoredarray[i, 2] * 32;
  325.      s3 := vgastoredarray[i, 3] * 32;
  326.  
  327.      FOR j := 1 TO fontpoints DO
  328.      BEGIN
  329.        INC(o); chardefs^[o] := MEM[SEGA000:s3];
  330.        INC(o); chardefs^[o] := MEM[SEGA000:s2];
  331.        INC(o); chardefs^[o] := MEM[SEGA000:s1];
  332.        INC(o); INC(s1); INC(s2); INC(s3);
  333.      END;
  334.    END;
  335.  
  336.    s := eventx MOD mousetextscale;
  337.    a := $FF000000 SHL (mousetextscale - s);
  338.  
  339.    d  := @chardefs^[(eventy MOD fontpoints) * SIZEOF(LONGINT)];
  340.    ms := @vgatextgraphicptr^;
  341.    mc := @vgatextgraphicptr^[charheight];
  342.  
  343.    FOR i := 1 TO charheight DO
  344.    BEGIN
  345.      d^ := (d^ and ((ms^ shr s) or a)) or (mc^ shr s);
  346.      INC(WORD(d), SIZEOF(LONGINT));
  347.      INC(WORD(mc), SIZEOF(LONGINT));
  348.      INC(WORD(ms), SIZEOF(LONGINT));
  349.    END;
  350.  
  351.    ASM
  352.      MOV DX, sequencerport
  353.      MOV AX, cpuwritemap2
  354.      OUT DX, AX
  355.    END;
  356.  
  357.    o := 0;
  358.    for i := 0 to 2 do begin
  359.       s1 := (defChar + 3 * i    ) * 32;
  360.       s2 := (defChar + 3 * i + 1) * 32;
  361.       s3 := (defChar + 3 * i + 2) * 32;
  362.       for j := 1 to fontPoints do begin
  363.          inc(o); { skip 4th byte }
  364.          mem[segA000:s3] := charDefs^[o];
  365.             { this code is changed to minimize DS variable space ! - RL }
  366.          inc(o);
  367.          mem[segA000:s2] := charDefs^[o];
  368.          inc(o);
  369.          mem[segA000:s1] := charDefs^[o];
  370.          inc(o);
  371.          inc(s1);
  372.          inc(s2);
  373.          inc(s3);
  374.       end; { for j }
  375.    end; { for i }
  376.  
  377.    (* now we will return the graphic adapter back to normal *)
  378.  
  379.    asm
  380.       pushf;
  381.       cli; { disable intr .. }
  382.       mov dx, sequencerPort;
  383.       mov ax, sequencerAddrNrml;
  384.       out dx, ax;
  385.       mov ax, oddEvenAddr;
  386.       out dx, ax;
  387.  
  388.       mov dx, vgaControlerPort;
  389.       mov ax, 4; { map 0 for cpu reads }
  390.       out dx, ax;
  391.       mov ax, $1005;
  392.       out dx, ax;
  393.       mov ax, mapStartAddrB800;
  394.       out dx, ax
  395.       popf;
  396.    end; { asm }
  397.  
  398.    vgaScreen2Array(true, false, true); { go ahead and paint it .. }
  399.  
  400. end; {drawVGATextGraphicCursor}
  401.  
  402. (******************************************************************************
  403. *                               showMouseCursor                               *
  404. ******************************************************************************)
  405. procedure showMouseCursor;
  406.  
  407. begin
  408.  inc(mouseCursorLevel);
  409.    if (not vgaTextGraphicCursor) then begin
  410.     regs.ax:=1; {enable cursor display}
  411.     INTR($33, regs);
  412.    end else if ((mouseCursorLevel = 1) and mouse_present) then begin
  413.       vgaScreen2Array(true, true, false);
  414.       hasStoredArray := true;
  415.       drawVGATextGraphicCursor;
  416.    end;
  417. end; {showMouseCursor}
  418.  
  419. (******************************************************************************
  420. *                               hideMouseCursor                               *
  421. ******************************************************************************)
  422. procedure hideMouseCursor;
  423.  
  424. begin
  425.  dec(mouseCursorLevel);
  426.    if (not vgaTextGraphicCursor) then begin
  427.     regs.ax:=2; {disable cursor display}
  428.     INTR($33, regs);
  429.    end else if ((mouseCursorLevel = 0) and (hasStoredArray)) then begin
  430.       vgaScreen2Array(false, false, false);
  431.       hasStoredArray := false;
  432.    end;
  433. end; {hideMouseCursor}
  434.  
  435.  
  436. (******************************************************************************
  437. *                                  getButton                                  *
  438. ******************************************************************************)
  439. function getButton(Button : Byte) : buttonState;
  440.  
  441. begin
  442.         regs.ax := 3;
  443.         INTR($33, regs);
  444.         if ((regs.bx and Button) <> 0) then
  445.                 getButton := buttonDown
  446.                 {bit 0 = left, 1 = right, 2 = middle}
  447.         else getButton := buttonUp;
  448. end; {getButton}
  449.  
  450. (******************************************************************************
  451. *                                buttonPressed                                *
  452. ******************************************************************************)
  453. function buttonPressed : boolean;
  454.  
  455. begin
  456.         regs.ax := 3;
  457.         INTR($33, regs);
  458.         if ((regs.bx and 7) <> 0) then
  459.                 buttonPressed := True
  460.         else buttonPressed := False;
  461. end; {buttonPressed}
  462.  
  463.  
  464. (******************************************************************************
  465. *                                 lastXPress                                  *
  466. ******************************************************************************)
  467. function lastXPress(Button : Byte) : word;
  468.  
  469. begin
  470.         regs.ax := 5;
  471.         regs.bx := Button;
  472.         INTR($33, regs);
  473.         lastXPress := regs.cx;
  474. end; {lastXpress}
  475.  
  476. (******************************************************************************
  477. *                                 lastYPress                                  *
  478. ******************************************************************************)
  479. function lastYPress(Button : Byte) : word;
  480.  
  481. begin
  482.         regs.ax := 5;
  483.         regs.bx := Button;
  484.         INTR($33, regs);
  485.         lastYPress := regs.dx;
  486. end; {lastYpress}
  487.  
  488. (******************************************************************************
  489. *                                buttonPresses                                *
  490. ******************************************************************************)
  491. function buttonPresses(Button : Byte) : word; {from last check}
  492.  
  493. begin
  494.         regs.ax := 5;
  495.         regs.bx := Button;
  496.         INTR($33, regs);
  497.         buttonPresses := regs.bx;
  498. end; {buttonPresses}
  499.  
  500. (******************************************************************************
  501. *                                lastXRelease                                 *
  502. ******************************************************************************)
  503. function lastXRelease(Button : Byte) : word;
  504.  
  505. begin
  506.         regs.ax := 6;
  507.         regs.bx := Button;
  508.         INTR($33, regs);
  509.         lastXRelease := regs.cx;
  510. end; {lastXRelease}
  511.  
  512. (******************************************************************************
  513. *                                lastYRelease                                 *
  514. ******************************************************************************)
  515. function lastYRelease(Button : Byte) : word;
  516.  
  517. begin
  518.         regs.ax := 6;
  519.         regs.bx := Button;
  520.         INTR($33, regs);
  521.         lastYRelease := regs.dx;
  522. end; {lastYRelease}
  523.  
  524. (******************************************************************************
  525. *                               buttonReleases                                *
  526. ******************************************************************************)
  527. function buttonReleases(Button : Byte) : word; {from last check}
  528.  
  529. begin
  530.         regs.ax := 6;
  531.         regs.bx := Button;
  532.         INTR($33, regs);
  533.         buttonReleases := regs.bx;
  534. end; {buttonReleases}
  535.  
  536. (******************************************************************************
  537. *                             HardwareTextCursor                              *
  538. ******************************************************************************)
  539. procedure HardwareTextCursor(fromLine,toLine : byte);
  540.  
  541. {set text cursor to text, using the scan lines from..to,
  542.         same as intr 10 cursor set in bios :
  543.         color scan lines 0..7, monochrome 0..13 }
  544.  
  545. begin
  546.         regs.ax := 10;
  547.         regs.bx := 1; {hardware text}
  548.         regs.cx := fromLine;
  549.         regs.dx := toLine;
  550.         INTR($33, regs);
  551. end; {hardwareTextCursor}
  552.  
  553. (******************************************************************************
  554. *                             softwareTextCursor                              *
  555. ******************************************************************************)
  556. procedure softwareTextCursor(screenMask,cursorMask : word);
  557.  
  558. { when in this mode the cursor will be achived by ANDing the screen word
  559.         with the screen mask (Attr,Char in high,low order) and
  560.         XORing the cursor mask, ussually used by putting the screen attr
  561.         we want preserved in screen mask (and 0 into screen mask character
  562.         byte), and character + attributes we want to set into cursor mask}
  563.  
  564. begin
  565.         regs.ax := 10;
  566.         regs.bx := 0;        {software cursor}
  567.         regs.cx := screenMask;
  568.         regs.dx := cursorMask;
  569.         INTR($33, regs);
  570. end; {softwareMouseCursor}
  571.  
  572. (******************************************************************************
  573. *                               recentXmovement                               *
  574. ******************************************************************************)
  575. function recentXmovement : direction;
  576.  
  577. {from recent call to which direction did we move ?}
  578.  
  579. var d : integer;
  580.  
  581. begin
  582.         regs.ax := 11;
  583.         INTR($33, regs);
  584.         d := regs.cx;
  585.         if (d > 0)
  586.                 then recentXmovement := moveRight
  587.         else if (d < 0)
  588.                 then recentXmovement := moveLeft
  589.         else recentXmovement := noMove;
  590. end; {recentXmovement}
  591.  
  592. (******************************************************************************
  593. *                               recentYmovement                               *
  594. ******************************************************************************)
  595. function recentYmovement : direction;
  596.  
  597. {from recent call to which direction did we move ?}
  598.  
  599. var
  600.    d : integer;
  601. begin
  602.         regs.ax := 11;
  603.         INTR($33, regs);
  604.         d := regs.dx;
  605.         if (d > 0)
  606.                 then recentYmovement := moveDown
  607.         else if (d < 0)
  608.                 then recentYmovement := moveUp
  609.         else recentYmovement := noMove;
  610. end; {recentYmovement}
  611.  
  612.  
  613. (******************************************************************************
  614. *                               setEventHandler                               *
  615. ******************************************************************************)
  616. procedure setEventHandler(mask : word; handler        : pointer);
  617.  
  618. {handler must be a far interrupt routine }
  619.  
  620. begin
  621.         regs.ax := 12; {set event handler function in mouse driver}
  622.         regs.cx := mask;
  623.         regs.es := seg(handler^);
  624.         regs.dx := ofs(handler^);
  625.         INTR($33, regs);
  626.         lastMask := mask;
  627.         lastHandler := handler;
  628. end; {set event Handler}
  629.  
  630. (******************************************************************************
  631. *                               defaultHandler                                *
  632. ******************************************************************************)
  633. {$F+} procedure defaultHandler; assembler; {$F-}
  634. asm
  635.    push ds; { save TP mouse driver }
  636.    mov ax, SEG @data;
  637.    mov ds, ax; { ds = TP:ds, not the driver's ds }
  638.    mov eventX, cx; { where in the x region did it occur }
  639.    mov eventY, dx;
  640.    mov eventButtons, bx;
  641.    mov eventHappened, 1; { eventHapppened := true }
  642.    pop ds; { restore driver's ds }
  643.    ret;
  644. end;
  645.  
  646. {   this is the default event handler , it simulates :
  647.  
  648.       begin
  649.                eventX := cx;
  650.                eventY := dx;
  651.                eventButtons := bx;
  652.                eventhappened := True;
  653.       end;
  654.  
  655. }
  656.  
  657. (******************************************************************************
  658. *                                doPascalStuff                                *
  659. * this is the pascal stuff that is called when vgaTextGraphicCursor mode has  *
  660. * to update the screen.                                                       *
  661. ******************************************************************************)
  662. procedure doPascalStuff; far;
  663. begin
  664.    if (mouseCursorLevel > 0) then begin
  665.       if (hasStoredArray) then begin
  666.          VGAscreen2Array(false, false, false); { move old array to screen -
  667. restore }
  668.          hasStoredArray := false;
  669.       end;
  670.       if (mouseCursorLevel > 0) then begin
  671.          VGAscreen2Array(true, true, false); { move new - from screen to array
  672. }
  673.          hasStoredArray := true; { now we have a stored array }
  674.          drawVGATextGraphicCursor; { do the low level stuff here }
  675.          lastEventX := eventX;
  676.          lastEventY := eventY; { this is the old location }
  677.       end; { go ahead and draw it ... }
  678.    end; { cursorLevel > 0 }
  679. end; {doPascalStuff}
  680.  
  681. (******************************************************************************
  682. *                            vgaTextGraphicHandler                            *
  683. * this is the same as default handler, only we do the mouse location movement *
  684. * ourself. Notice - if you use another handler, for mouse movement with       *
  685. * VGA text graphic cursor - do the same !!!                                   *
  686. ******************************************************************************)
  687. procedure vgaTextGraphicHandler; far; assembler;
  688. label
  689.    noCursorMove;
  690. asm
  691.    push ds; { save TP mouse driver }
  692.    push ax;
  693.    mov ax, SEG @data;
  694.    mov ds, ax; { ds = TP:ds, not the driver's ds }
  695.    pop ax; { ax has the reason .. }
  696.    mov eventX, cx; { where in the x region did it occur }
  697.    mov eventY, dx;
  698.    mov eventButtons, bx;
  699.    mov eventHappened, 1; { eventHapppened := true }
  700.    and ax, CURSOR_LOCATION_CHANGED; { o.k., do we need to handle mouse movement? }
  701.    jz noCursorMove;
  702.    call doPascalStuff;
  703.    mov eventHappened, 0;
  704.    { NOTICE - no movement events are detected in the out world ! - this is a
  705.      wintext consideration - It might be needed to track mouse movements,
  706.      and then it should be changed ! - but this is MY default handler ! }
  707. noCursorMove: { no need for cursor movement handling }
  708.    pop ds; { restore driver's ds }
  709. end; {vgaTextGraphicHandler}
  710.  
  711. (******************************************************************************
  712. *                                GetLastEvent                                 *
  713. ******************************************************************************)
  714. function GetLastEvent(var x,y : word;
  715.         var left_button,right_button,middle_button : buttonState) : boolean;
  716.  
  717. begin
  718.         getLastEvent := eventhappened; {indicate if any event happened}
  719.         eventhappened := False; {clear to next read/event}
  720.         x := eventX;
  721.         y := eventY;
  722.         if ((eventButtons and cLinke_taste) <> 0) then
  723.                 left_button := buttonDown
  724.         else left_button := buttonUp;
  725.         if ((eventButtons and cRechte_taste) <> 0) then
  726.                 right_button := buttonDown
  727.         else right_button := buttonUp;
  728.         if ((eventButtons and cMittlere_taste) <> 0) then
  729.                 middle_button := buttonDown
  730.         else middle_button := buttonUp;
  731. end; {getLastEvent}
  732.  
  733. (******************************************************************************
  734. *                              setDefaultHandler                              *
  735. ******************************************************************************)
  736. procedure setDefaultHandler(mask : WORD);
  737.  
  738. {get only event mask, and set event handler to defaultHandler}
  739.  
  740. begin
  741.    if (vgaTextGraphicCursor) then begin
  742.       mask := mask or CURSOR_LOCATION_CHANGED; { we MUST detect cursor movement
  743. }
  744.            setEventHandler(mask,@vgaTextGraphicHandler);
  745.    end else
  746.            setEventHandler(mask,@defaultHandler);
  747. end; {setDefaultHandler}
  748.  
  749. (******************************************************************************
  750. *                              defineSensetivity                              *
  751. ******************************************************************************)
  752. procedure defineSensetivity(x,y : word);
  753.  
  754. begin
  755.         regs.ax := 15;
  756.         regs.cx := x; {# of mouse motions to horizontal 8 pixels}
  757.         regs.dx := y; {# of mouse motions to vertical 8 pixels}
  758.         INTR($33, regs);
  759.         XMotions := x;
  760.         YMotions := y; {update global unit variables}
  761. end; {defineSensetivity}
  762.  
  763. (******************************************************************************
  764. *                              setHideCursorBox                               *
  765. ******************************************************************************)
  766. procedure setHideCursorBox(left,top,right,bottom : word);
  767.  
  768. begin
  769.         regs.ax := 16;
  770.         regs.es := seg(HideBox);
  771.         regs.dx := ofs(HideBox);
  772.         HideBox.left := left;
  773.         HideBox.right := right;
  774.         HideBox.top := top;
  775.         HideBox.bottom := bottom;
  776.         INTR($33, regs);
  777. end; {setHideCursorBox}
  778.  
  779. (******************************************************************************
  780. *                               waitForRelease                                *
  781. * Wait until button is release, or timeOut 1/100 seconds pass. (might miss a  *
  782. * tenth (1/10) of a second.                                                                                                                     *
  783. ******************************************************************************)
  784. procedure waitForRelease(timeout : WORD);
  785. var
  786.     sHour, sMinute, sSecond, sSec100 : word;        { Time at start }
  787.     cHour, cMinute, cSecond, cSec100 : word;        { Current time        }
  788.     stopSec                             : longInt;
  789.     currentSec                          : longInt;
  790.     Delta                             : longInt;
  791. begin
  792.     getTime(sHour, sMinute, sSecond, sSec100);
  793.     stopSec := (sHour*36000 + sMinute*600 + sSecond*10 + sSec100 + timeOut) mod
  794.                     (24*360000);
  795.     repeat
  796.            getTime(cHour, cMinute, cSecond, cSec100);
  797.            currentSec := (cHour*36000 + cMinute*600 + cSecond*10 + cSec100);
  798.            Delta := currentSec - stopSec;
  799.     until (not ButtonPressed) or (Delta >=0) and (Delta < 36000);
  800. end; {waitForRelease}
  801.  
  802. (******************************************************************************
  803. *                              swapEventHandler                               *
  804. * handler is a far routine.                                                   *
  805. ******************************************************************************)
  806. procedure swapEventHandler(mask : WORD; handler : POINTER);
  807. begin
  808.    regs.ax := $14;
  809.    regs.cx := mask;
  810.         regs.es := seg(handler^);
  811.         regs.dx := ofs(handler^);
  812.         INTR($33, regs);
  813.    lastMask := regs.cx;
  814.    lastHandler := ptr(regs.es,regs.dx);
  815. end; {swapEventHandler}
  816.  
  817. (******************************************************************************
  818. *                            getMouseSaveStateSize                            *
  819. ******************************************************************************)
  820. function getMouseSaveStateSize : WORD;
  821. begin
  822.    regs.ax := $15;
  823.    INTR($33, regs);
  824.    getMouseSaveStateSize := regs.bx;
  825. end; {getMouseSaveStateSize}
  826.  
  827. (******************************************************************************
  828. *                           setVgaTextGraphicCursor                           *
  829. ******************************************************************************)
  830. procedure setVgaTextGraphicCursor;
  831. begin
  832.    vgaTextGraphicCursor := false; { assume we can not .. }
  833.    if (queryAdapterType <> vgaColor) then
  834.       exit;
  835.    vgaTextGraphicCursor := true;
  836. end; {setVgaTextGraphicCursor}
  837.  
  838. (******************************************************************************
  839. *                          resetVgaTextGraphicCursor                          *
  840. ******************************************************************************)
  841. PROCEDURE resetvgatextgraphiccursor;
  842. BEGIN
  843.   vgatextgraphiccursor := FALSE;
  844. END;
  845.  
  846. PROCEDURE myexitproc; FAR;
  847. BEGIN
  848.   EXITPROC := oldexitproc;
  849.   IF (vgatextgraphiccursor AND hasstoredarray) THEN
  850.     vgascreen2array(FALSE, FALSE, FALSE);
  851.   DISPOSE(chardefs);
  852.   resetvgatextgraphiccursor;
  853.   initmouse;
  854. END;
  855.  
  856. PROCEDURE set_graphic_mouse_cursor;         { graphischen Mauscursor setzen }
  857. BEGIN
  858.   setvgatextgraphiccursor; initmouse; setdefaulthandler(left_button_pressed);
  859. END;
  860.  
  861. { ─ Hauptprogramm der Unit ──────────────────────────────────────────────── }
  862. BEGIN
  863.    eventx := 0; eventy := 0; eventhappened := FALSE;
  864.    NEW(chardefs); initmouse;
  865.    oldexitproc := EXITPROC;
  866.    EXITPROC    := @myexitproc;
  867. END.
  868.  
  869.